home *** CD-ROM | disk | FTP | other *** search
/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / FilmOnet (PL).ifs < prev    next >
Encoding:
Text File  |  2004-10-03  |  11.6 KB  |  397 lines
  1. // GETINFO SCRIPTING
  2. // Onet(PL) import, made by Cabal & Mirwoj
  3.  
  4. (********************************************************
  5.  *  Film.Onet.pl movie information importation script   *
  6.  *           (c) 2003 Cabal & Mirwoj                    *
  7.  *  based on Filmweb.pl version (c) 2002 Piotr Kardasz  *
  8.  *                                                      *
  9.  *  Works fine, but return nothing when movie does not  *
  10.  *  exists on film.onet.pl                              *
  11.  *  Script does not affect original movie title [in     *
  12.  *  order not to change it when wrong movie found, but  *
  13.  *  it can be changed - just uncomment one line]        *
  14.  *                                                      *
  15.  *  For use with Ant Movie Catalog 3.2.1                *
  16.  *  www.ant.be.tf/moviecatalog ╖╖╖ www.buypin.com       *
  17.  ********************************************************)
  18.  
  19. program Onet;
  20. var
  21.   MovieName: string;
  22.  
  23. procedure DelSpace(var Value: String);
  24. var
  25.   FullValue: String;
  26.   Counter: Integer;
  27. begin
  28.   if Value <> '' then
  29.   begin
  30.     FullValue := FullValue + StrGet(Value, 1);
  31.     for Counter := 2 to Length(Value) do
  32.     begin
  33.       if StrGet(Value, Counter) <> ' ' then
  34.         FullValue := FullValue + StrGet(Value, Counter)
  35.       else
  36.         if StrGet(FullValue, Length(FullValue)) <> ' ' then
  37.           FullValue := FullValue + ' ';
  38.     end;
  39.     Value := FullValue;
  40.   end
  41. end;
  42.  
  43. procedure DecodeHTML(var Value: String);
  44. var
  45.   FullValue, CharCode: String;
  46.   Counter: Integer;
  47. begin
  48.   if Value <> '' then
  49.   begin
  50.     FullValue := '';
  51.     Counter := 1;
  52.     repeat
  53.       if StrGet(Value, Counter) <> '&' then
  54.         begin
  55.           CharCode := copy(Value, Counter, 1);
  56.           case CharCode of
  57.             '▒': CharCode := '╣';
  58.             '╢': CharCode := '£';
  59.             '╝': CharCode := 'ƒ';
  60.             'ª': CharCode := 'î';
  61.             'í': CharCode := 'Ñ';
  62.             '¼': CharCode := 'Å';
  63.           end;
  64.           FullValue := FullValue + CharCode;
  65.           Counter := Counter + 1;
  66.         end
  67.       else
  68.         begin
  69.           CharCode := copy(Value, Counter, 7);
  70.           case CharCode of
  71.             'ą': FullValue := FullValue + '╣';
  72.             'ć': FullValue := FullValue + 'µ';
  73.             'ę': FullValue := FullValue + 'Ω';
  74.             'ł': FullValue := FullValue + '│';
  75.             'ń': FullValue := FullValue + '±';
  76.             'ó': FullValue := FullValue + '≤';
  77.             'ś': FullValue := FullValue + '£';
  78.             'ź': FullValue := FullValue + 'ƒ';
  79.             'ż': FullValue := FullValue + '┐';
  80.             'Ą': FullValue := FullValue + 'Ñ';
  81.             'Ć': FullValue := FullValue + '╞';
  82.             'Ę': FullValue := FullValue + '╩';
  83.             'Ł': FullValue := FullValue + 'ú';
  84.             'Ń': FullValue := FullValue + '╤';
  85.             'Ó': FullValue := FullValue + '╙';
  86.             'Ś': FullValue := FullValue + 'î';
  87.             'Ź': FullValue := FullValue + 'Å';
  88.             'Ż': FullValue := FullValue + '»';   
  89.           else
  90.             FullValue := FullValue + CharCode;  
  91.           end;
  92.           Counter := Counter + 7;
  93.         end;
  94.     until Counter > Length(Value);
  95.     HTMLDecode(FullValue);
  96.     Value := FullValue;
  97.   end
  98. end;
  99.  
  100. procedure StripHTML(var sString: string);
  101. var i:integer;
  102.     sTemp: string;
  103.     bOutHTML: boolean;
  104.     cChar: char;
  105. begin
  106.   sTemp := sString;
  107.   sString := '';
  108.   bOutHTML := TRUE;
  109.     
  110.   for i :=1 to Length(sTemp) do
  111.   begin
  112.     cChar := Copy(sTemp,i,1);
  113.     if (cChar = '<') then bOutHTML := FALSE;
  114.     if (bOutHTML) then
  115.     sString := sString + cCHar;
  116.     if (cChar = '>') then bOutHTML := TRUE;
  117.   end;
  118. end;
  119.  
  120. function CountStrings(sString: String; sWhat: String): Integer;
  121. var
  122.   iCnt: Integer;
  123.   iPos: Integer;
  124. begin
  125.   iCnt := 0;
  126.   iPos := Pos(sWhat, sString);
  127.   while iPos > 0 do
  128.   begin
  129.     iCnt := iCnt + 1;
  130.     sString := Copy(sString, iPos + 1, Length(sString));
  131.     iPos := Pos(sWhat, sString);
  132.   end;
  133.   Result := iCnt;
  134. end;
  135.  
  136. function RetrieveMovieTitle(sTitleBff: String): String;
  137. var
  138.   iEndPos: Integer;
  139. begin
  140.   iEndPos := Pos('</B>', sTitleBff);
  141.   if iEndPos > 0 then
  142.     Result := Copy(sTitleBff, 1, iEndPos - 1)
  143.   else
  144.     Result := '???';
  145.  
  146.   DecodeHTML(Result);
  147.   HTMLRemoveTags(Result);
  148. end;
  149.  
  150. function AddMoviesTitles(Page: TStringList; iCnt: Integer): Integer;
  151. var
  152.   MovieTitle: string;
  153.   i, iPos: Integer;
  154.   cChar: Char;
  155.   iNumLen: Integer;
  156.   sNum: String;
  157.   sPage: String;
  158.   oPage: TStringList;
  159.  
  160. begin
  161.     sPage := Page.Text;
  162.  
  163.     if (iCnt = 1) then
  164.     begin
  165.       iPos := Pos(',film.html" class=', sPage) - 1;
  166.       MovieTitle := RetrieveMovieTitle(Copy(sPage, iPos + 24, 200));
  167.  
  168.       cChar := Copy(sPage, iPos, 1);
  169.       iNumLen := 0;
  170.       while (cChar >= '0') and (cChar <= '9') do
  171.       begin
  172.         iNumLen := iNumLen + 1;
  173.         iPos := iPos - 1;
  174.         cChar := Copy(sPage, iPos, 1);
  175.       end;
  176.       sNum := Copy(sPage, iPos + 1, iNumLen);
  177.       oPage := TStringList.Create;
  178.       oPage.Text := GetPage('http://film.onet.pl/' + sNum +',film.html');
  179.       AnalyzeMoviePage(oPage, 'http://film.onet.pl/' + sNum +',film.html')
  180.     end
  181.     
  182.     else
  183.     
  184.     begin
  185.       PickTreeAdd('Znaleziono filmy:', '');
  186.       for i := 1 to iCnt do
  187.       begin
  188.         iPos := Pos(',film.html" class=', sPage) - 1;
  189.         MovieTitle := RetrieveMovieTitle(Copy(sPage, iPos + 24, 200));
  190.  
  191.         cChar := Copy(sPage, iPos, 1);
  192.         iNumLen := 0;
  193.         while (cChar >= '0') and (cChar <= '9') do
  194.         begin
  195.           iNumLen := iNumLen + 1;
  196.           iPos := iPos - 1;
  197.           cChar := Copy(sPage, iPos, 1);
  198.         end;
  199.         sNum := Copy(sPage, iPos + 1, iNumLen);
  200.       //ShowMessage('URL: http://film.onet.pl/' + sNum +',film.html');
  201.         PickTreeAdd(MovieTitle, 'http://film.onet.pl/' + sNum +',film.html');
  202.  
  203.         sPage := Copy(sPage, iPos + 50, Length(sPage));
  204.       end;
  205.     end;
  206. end;
  207.  
  208. procedure AnalyzePage(Address: string);
  209. var
  210.   Page: TStringList;
  211.   FilmCount, iCnt: Integer;
  212. begin
  213.   Page := TStringList.Create;
  214.   Page.Text := GetPage(Address);
  215.   if pos('Wynik wyszukiwania', Page.Text) = 0 then
  216.     AnalyzeMoviePage(Page, Address)
  217.   else
  218.   begin
  219.     iCnt := CountStrings(Page.Text, ',film.html" class=');
  220.     if(iCnt > 0) then
  221.     begin
  222.     if(iCnt = 1) then AddMoviesTitles(Page, iCnt)
  223.     else
  224.     begin
  225.     PickTreeClear;
  226.     AddMoviesTitles(Page, iCnt);
  227.     if PickTreeExec(Address) then
  228.       AnalyzePage(Address);
  229.     end;
  230.     end;
  231.   end;
  232.   Page.Free;
  233. end;
  234.  
  235. procedure AnalyzeMoviePage(Page: TStringList; sURL: String);
  236. var
  237.   sPage, sValue, sTemp, sPosterURL, sPicUrl: string;
  238.   iPos, iStartPos, iEndPos, iLength: Integer;
  239.   cChar: char;
  240. begin
  241.   sPage := Page.Text;
  242.  
  243.   // Page URL
  244.   SetField(fieldURL, sURL);
  245.  
  246.   // Polish title
  247.   iStartPos := pos('class=tyw', sPage) + 10;
  248.   sPage := Copy(sPage, iStartPos, Length(sPage));
  249.   iEndPos := pos('TD', sPage) - 3;
  250.   sValue := Copy(sPage, 1, iEndPos);
  251.   DecodeHTML(sValue);
  252.   SetField(fieldTranslatedTitle, sValue);
  253.   sPage := Copy(sPage, iEndPos, Length(sPage));
  254.  
  255.   // Oryginal title
  256.   iStartPos := pos('<B>', sPage) + 3;
  257.   iEndPos := pos('</B>', sPage);
  258.   if iStartPos < pos(' (', sPage) then
  259.   begin
  260.   iLength := iEndPos - iStartPos;
  261.   sValue := Copy(sPage, iStartPos, iLength);
  262.   DecodeHTML(sValue);
  263.   //Uncomment this line if you want to save found original title
  264.   //SetField(fieldOriginalTitle, sValue);
  265.   end;
  266.   
  267.   // Country
  268.   iStartPos := pos(' (', sPage) + 2;
  269.   sPage := Copy(sPage, iStartPos, Length(sPage));
  270.   iEndPos := pos(')', sPage) - 7;
  271.   sValue := Copy(sPage, 1, iEndPos);
  272.   DecodeHTML(sValue);
  273.   SetField(fieldCountry, sValue);
  274.   sPage := Copy(sPage, iEndPos, Length(sPage));
  275.  
  276.   // Year of production
  277.   iStartPos := pos(')', sPage) -5;
  278.   sPage := Copy(sPage, iStartPos, Length(sPage));
  279.   iEndPos := pos(')', sPage) - 1;
  280.   sValue := Copy(sPage, 1, iEndPos);
  281.   SetField(fieldYear, sValue);
  282.   sPage := Copy(sPage, iEndPos, Length(sPage));
  283.  
  284.   // Category
  285.   iStartPos := pos('<BR>', sPage) + 4;
  286.   sPage := Copy(sPage, iStartPos, Length(sPage));
  287.   iEndPos := pos('<BR>', sPage) - 1;
  288.   sValue := Copy(sPage, 1, iEndPos);
  289.   DecodeHTML(sValue);
  290.   SetField(fieldCategory, sValue);
  291.   sPage := Copy(sPage, iEndPos, Length(sPage));
  292.   
  293.   // Length
  294.   iStartPos := pos('czas ', sPage) + 5;
  295.   iEndPos := pos('min', sPage) - 1;
  296.   iLength := iEndPos - iStartPos;
  297.   sValue := Copy(sPage, iStartPos, iLength);
  298.   SetField(fieldLength, sValue);
  299.  
  300.   // Director
  301.   iStartPos := pos('yseria', sPage) + 19;
  302.   sPage := Copy(sPage, iStartPos, Length(sPage));
  303.   iEndPos := pos('Scenariusz', sPage) - 5;
  304.   sValue := Copy(sPage, 1, iEndPos);
  305.   StripHTML(sValue);
  306.   DecodeHTML(sValue);
  307.   SetField(fieldDirector, sValue);
  308.   sPage := Copy(sPage, iEndPos, Length(sPage));
  309.  
  310. {
  311.   // Large picture, I'm not sure if this works
  312.   // Uncommeht this section and comment Small picture if you want to download posters
  313.   iStartPos := pos(',plakat.html', sPage);
  314.   if (iStartPos > 0) then
  315.   begin
  316.     sValue := GetField(fieldComments) + '   Znaleznione plakaty: ';
  317.     cChar := Copy(sPage, iStartPos, 1);
  318.     while (cChar <> '"') do
  319.     begin
  320.       iStartPos := iStartPos - 1;
  321.       iLength := iLength + 1;
  322.       cChar := Copy(sPage, iStartPos, 1);
  323.     end;
  324.     iPos := 2;
  325.     sPosterURL :='http://film.onet.pl/' + Copy(sPage, (iStartPos + 1), (iLength-1)) + ',plakat.html';
  326.     sTemp := GetPage(sPosterURL);
  327.     iStartPos := pos('IMG class=pic border=1 src="', sTemp) + 28;
  328.     sTemp := Copy(sTemp, iStartPos, Length(sTemp));;
  329.     iEndPos := pos('"', sTemp) - 1;
  330.     sValue := sValue + 'http://film.onet.pl/' + Copy(sTemp, 1, iEndPos);
  331.     
  332.     
  333.     SetField(fieldComments, sValue);
  334.   end;
  335. }
  336.   // Small picture
  337.   iStartPos := pos('src=', sPage) + 5;
  338.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  339.   iStartPos := pos('src="', sTemp) + 5;
  340.   sTemp := Copy(sTemp, iStartPos, Length(sTemp));
  341.   iEndPos := pos('"', sTemp)-1;
  342.   sPicURL := 'http://film.onet.pl/' + Copy(sTemp, 1, iEndPos);
  343.   GetPicture(sPicURL, False); // False = do not store picture externally ; store it in the catalog file
  344.  
  345.   // Actors
  346.   iStartPos := pos('Obsada', sPage);
  347.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  348.   iStartPos :=pos('<TABLE', sTemp);
  349.   sTemp := Copy(sTemp, iStartPos, Length(sPage));
  350.   iEndPos := pos('wiΩcej', sTemp) - 5;
  351.   sValue := Copy(sTemp, 1, iEndPos);
  352.   sValue := StringReplace(sValue, '</TR><TR>', ', ');
  353.   StripHTML(sValue);
  354.   DecodeHTML(sValue);
  355.   
  356.   iEndPos := Length(sValue);
  357.   cChar := Copy(sValue, iEndPos, 1);
  358.   while (cChar = ',') or (cChar = ' ') do
  359.   begin
  360.     iEndPos := iEndPos - 1;
  361.     cChar := Copy(sValue, iEndPos, 1);
  362.   end;
  363.   sValue := Copy(sValue, 1, iEndPos);
  364.   SetField(fieldActors, sValue);
  365.  
  366.   // Description
  367.   iStartPos := pos('Tre', sPage);
  368.   if (iStartPos > 0) then
  369.   begin
  370.   iStartPos := iStartPos + 5;
  371.   sTemp := Copy(sPage, iStartPos, Length(sPage));
  372.   iEndPos := pos('</DIV>', sTemp);
  373.   sValue := Copy(sTemp, 1, iEndPos);
  374.   StripHTML(sValue);
  375.   DecodeHTML(sValue);
  376.   SetField(fieldDescription, sValue);
  377.   end
  378.   else SetField(fieldDescription, 'Brak');
  379.  
  380.   DisplayResults;
  381. end;
  382.  
  383.  
  384. begin
  385.   if CheckVersion(3,2,1) then
  386.   begin
  387.     MovieName := GetField(fieldOriginalTitle);
  388.     if Input('Film.Onet.Pl Import by Cabal & Mirwoj', 'Podaj oryginalny tytu│ filmu:', MovieName) then
  389.     begin
  390.       AnalyzePage('http://film.onet.pl/filmoteka.html?O=1&S='+UrlEncode(MovieName));
  391.     end;
  392.   end
  393.   else ShowMessage('Skrypt wymaga programu Ant Movie Catalog w wersji 3.2.1 lub nowszej');
  394. end.
  395.  
  396.  
  397.